Avalições Auditor Crawler

Lendo os dados

resultados_avaliacoes = read_avaliacoes()

## Parsed with column specification:
## cols(
##   id = col_character(),
##   item = col_character(),
##   municipio = col_character(),
##   criterio = col_character(),
##   aproach = col_character(),
##   date = col_datetime(format = ""),
##   valid = col_logical(),
##   contNodeNumberAccess = col_double(),
##   found = col_logical(),
##   pathSought = col_character(),
##   durationMin = col_double(),
##   duration = col_double(),
##   tipo_exp = col_character()
## )

resultados_avaliacoes[is.na(resultados_avaliacoes)] <- ""

gararito = read_gabaritos()

## Parsed with column specification:
## cols(
##   municipio = col_character(),
##   criterio = col_character(),
##   item = col_character(),
##   encontrado = col_logical(),
##   local_encontrado = col_character(),
##   local_encontrado_2 = col_character()
## )

gararito[is.na(gararito)] <- ""

empresas_portais <- readr::read_csv(here::here("data/empresas_portais.csv"))

## Warning: Missing column names filled in: 'X8' [8], 'X9' [9], 'X10' [10],
## 'X11' [11], 'X12' [12], 'X13' [13], 'X14' [14], 'X15' [15], 'X16' [16],
## 'X17' [17], 'X18' [18]

## Parsed with column specification:
## cols(
##   municipio = col_character(),
##   link_portal_transp = col_character(),
##   link_prefeitura = col_character(),
##   observacoes = col_character(),
##   fornecedor = col_character(),
##   tipo_fornecer = col_character(),
##   `Fornecedor: Gestões Anteriores` = col_character(),
##   X8 = col_character(),
##   X9 = col_logical(),
##   X10 = col_logical(),
##   X11 = col_logical(),
##   X12 = col_logical(),
##   X13 = col_logical(),
##   X14 = col_logical(),
##   X15 = col_logical(),
##   X16 = col_logical(),
##   X17 = col_logical(),
##   X18 = col_character()
## )

Adicionando combinação encontrada em cada município no gabarito

empresas_portais <- empresas_portais %>% 
    select(municipio, fornecedor)

gararito<-left_join(gararito, empresas_portais, by=c("municipio"))

Juntando Avaliações e Gabaritos

# concatena os dois csv o do gabarito e avaliações do crawler
data<-full_join(resultados_avaliacoes, gararito, by=c("municipio", "item", "criterio"))

Sumarizando as avaliações

precisao <- data %>% 
    group_by(municipio, criterio, item, aproach, date) %>% 
    mutate(
           
           #verifica se a avaliação foi acertiva
           tp = valid == TRUE 
           & valid == encontrado 
           #valida se no gabarito e na avaliação o item foi encontrado na mesma url 
           & (grepl(local_encontrado, pathSought) |
                  grepl(local_encontrado_2, pathSought)),
           
           fn =  valid == FALSE 
           & encontrado == TRUE,
           
           fp = valid == TRUE 
           & encontrado == FALSE
          )

precisao %>%
    datatable(options = list(pageLength = 10),  rownames = FALSE, class = 'cell-border stripe')

## Warning in instance$preRenderHook(instance): It seems your data is too big
## for client-side DataTables. You may consider server-side processing: https://
## rstudio.github.io/DT/server.html

Quantificando métricas

metricas_result <- precisao %>% 
    #filter(!is.na(aproach )) %>% 
    group_by(municipio, aproach, date) %>% 
    summarise(
        tp_total = sum(tp), 
        fn_total = sum(fn),
        fp_total = sum(fp),
        
        #cálculo das métricas 
        recall = tp_total/(tp_total + fn_total),
        precision =  tp_total/(tp_total + fp_total),
        f1_score = (2*(recall*precision))/(recall+precision),
        
        #tempo das avaliações
        median_duration_min = median(durationMin),
        median_duration = median(duration),
        max_duration = max(duration),
        max_durationMin = max(durationMin),
        median_num_access_node = median(contNodeNumberAccess),
        max_num_access_node = max(contNodeNumberAccess),
        all_access_node = sum(contNodeNumberAccess),
        combination = last(fornecedor),
        tipo_exp = last(tipo_exp)
    )

metricas_result %>% 
    write_csv(here::here("data/resultados_sumarizado.csv"))

metricas_result 

## # A tibble: 162 x 18
## # Groups:   municipio, aproach [89]
##    municipio aproach date                tp_total fn_total fp_total recall
##    <chr>     <chr>   <dttm>                 <int>    <int>    <int>  <dbl>
##  1 Alcantil  bandit  2019-11-19 04:04:19       39        2        2  0.951
##  2 Alcantil  bfs     2019-11-11 22:58:13       39        2        2  0.951
##  3 Alcantil  bfs     2019-11-28 02:39:38       39        2        2  0.951
##  4 Alcantil  dfs     2019-11-22 15:33:46       40        1        3  0.976
##  5 Arara     bandit  2019-11-01 23:51:14       36        9        4  0.8  
##  6 Arara     bandit  2019-11-11 14:33:27       36        9        3  0.8  
##  7 Arara     bfs     2019-11-02 19:43:10       36        9        4  0.8  
##  8 Arara     bfs     2019-11-06 02:44:42       36        9        4  0.8  
##  9 Arara     bfs     2019-11-09 23:00:57       36        9        3  0.8  
## 10 Arara     bfs     2019-11-28 02:39:38       39        6        3  0.867
## # … with 152 more rows, and 11 more variables: precision <dbl>, f1_score <dbl>,
## #   median_duration_min <dbl>, median_duration <dbl>, max_duration <dbl>,
## #   max_durationMin <dbl>, median_num_access_node <dbl>,
## #   max_num_access_node <dbl>, all_access_node <dbl>, combination <chr>,
## #   tipo_exp <chr>

Avaliações por abordagem

metricas_result %>%
    group_by(aproach) %>% 
    summarise(ocorrencia = n()) %>%
    ggplot(aes(y=ocorrencia, x=reorder(aproach, +(ocorrencia)))) + 
    geom_bar(stat = "identity",  fill="#5499C7") + 
    ggtitle("Número de Avaliações por Abordagem") +
    xlab("Abordagem") + 
    ylab("Número de avaliações") +
    coord_flip()

Avaliações por valor do Recall e Precision

metricas_result %>%
    ggplot(aes(x=recall)) + 
    geom_histogram(alpha=0.5, position="identity", bins=20) 

metricas_result %>%
    ggplot(aes(x=precision)) + 
    geom_histogram(alpha=0.5, position="identity", bins=20) 

metricas_result %>%
    ggplot(aes(x=recall, color=aproach)) + 
    geom_histogram(fill='white', alpha=0.5, position="identity", bins=20) +
    facet_grid(aproach ~ .)

metricas_result %>%
    ggplot(aes(x=precision, color=aproach)) + 
    geom_histogram(fill='white', alpha=0.5, position="identity", bins=20) +
    facet_grid(aproach ~ .)

Avaliações por tempo (Min)

metricas_result %>%
    ggplot(aes(x=median_duration_min, color=aproach)) + 
    geom_histogram(fill='white', alpha=0.5, position="identity", bins=20) +
    facet_grid(aproach ~ .)

metricas_result %>%
    ggplot(aes(x=max_durationMin, color=aproach)) + 
    geom_histogram(fill='white', alpha=0.5, position="identity", bins=20) +
    facet_grid(aproach ~ .)

Avaliações por número de nós acessados

metricas_result %>%
    ggplot(aes(x=median_num_access_node, color=aproach)) + 
    geom_histogram(fill='white', alpha=0.5, position="identity", bins=20) +
    facet_grid(aproach ~ .)

metricas_result %>%
    ggplot(aes(x=max_num_access_node, color=aproach)) + 
    geom_histogram(fill='white', alpha=0.5, position="identity", bins=20) +
    facet_grid(aproach ~ .)

Avaliações com Recall abaixo de 0.7

Todas as Avaliações

metricas_result %>%
    group_by(municipio) %>%
    summarise(bfs = sum(aproach == 'bfs'), dfs = sum(aproach == 'dfs'), bandit = sum(aproach == 'bandit'), tipo_exp=last(tipo_exp)) %>%
    arrange(desc(dfs)) %>%
    datatable(options = list(pageLength = 10),  rownames = FALSE, class = 'cell-border stripe')

metricas_result %>%
    select(municipio, aproach, date, recall, precision, f1_score) %>%
    arrange(desc(recall)) %>% 
    datatable(options = list(pageLength = 30),  rownames = FALSE, class = 'cell-border stripe')

Métricas

metricas_result %>%
    ggplot() + 
    geom_point(aes(x=aproach, y=recall,  color=aproach), position = "jitter")  

metricas_result %>%
  ggplot(aes(x='',y = recall)) +
  geom_boxplot(fill = "white") +
  geom_jitter(aes(color = aproach), alpha=0.5, size=3)

metricas_result %>%
    ggplot(aes(x = aproach, y = recall)) +
    geom_boxplot(fill = "orange") 

metricas_result %>%
    ggplot() + 
    geom_point(aes(x=aproach, y=f1_score,  color=aproach), position = "jitter")  

Tempo de Duração

metricas_result %>%
    ggplot() + 
    geom_point(aes(x=aproach, y=median_duration_min,  color=aproach), position = "jitter")  

metricas_result %>%
    ggplot() + 
    geom_point(aes(x=aproach, y=max_durationMin,  color=aproach), position = "jitter")  

metricas_result %>%
  ggplot(aes(x='',y = max_durationMin)) +
  geom_boxplot(fill = "white") +
  geom_jitter(aes(color = aproach), alpha=0.5, size=3)

metricas_result %>%
    ggplot(aes(x = aproach, y = max_durationMin)) +
    geom_boxplot(fill = "orange") 

Nós Acessados

metricas_result %>%
    ggplot() + 
    geom_point(aes(x=aproach, y=max_num_access_node,  color=aproach), position = "jitter")  

metricas_result %>%
  ggplot(aes(x='',y = max_num_access_node)) +
  geom_boxplot(fill = "white") +
  geom_jitter(aes(color = aproach), alpha=0.5, size=3)

metricas_result %>%
    ggplot(aes(x = aproach, y = max_num_access_node), ) +
    geom_boxplot(fill = "orange") 

IC

set.seed(123)

f1_score <- function (d, i) {
    dt<-d[i,]
    c(
        dt$f1_score
    )
}
    
bootstraps <- boot(data = metricas_result, 
                   statistic = f1_score, # <- referência para a função 
                   R = 4000) # número de bootstraps


ci.tb = tidy(bootstraps, 
          conf.level = .95,
          conf.method = "basic",
          conf.int = TRUE) 


glimpse(ci.tb)

## Observations: 162
## Variables: 5
## $ statistic <dbl> 0.9512195, 0.9512195, 0.9512195, 0.9523810, 0.8470588, 0.85…
## $ bias      <dbl> -0.06600196, -0.06585157, -0.06682167, -0.06549871, 0.03858…
## $ std.error <dbl> 0.06160066, 0.06024994, 0.06339111, 0.06184019, 0.05980092,…
## $ conf.low  <dbl> 0.9294661, 0.9294661, 0.9294661, 0.9317889, 0.7211447, 0.74…
## $ conf.high <dbl> 1.1137066, 1.1166490, 1.1167247, 1.1190476, 0.9053853, 0.92…

ci.tb %>%
    ggplot(aes(x = "", y = statistic,
               ymin = conf.low,
               ymax = conf.high)) +
    geom_pointrange() +
    geom_point(size = 3) +
    labs(y = "F1-score",
         x = "") +
    theme(axis.title = element_text(size=10)) 

#Calcula a media das posições escolhidas nas buscas.
set.seed(123)

f1_score_boot <- function (d, i) {
    dt<-d[i,]
    c(
        dt$f1_score
    )
}

boot.aproach <- metricas_result %>%
  group_by(aproach) %>% 
  mutate(cors_boot = list(
      boot(
          data = metricas_result, 
          statistic = f1_score_boot, 
          R = 4000
          )
      )
     )

ics.aproach <- boot.aproach %>% 
    group_by(aproach) %>% 
    summarise(
        ci = list(tidy(cors_boot[[1]], 
          conf.level = .95,
          conf.method = "basic",
          conf.int = TRUE))
    ) %>% 
    unnest(ci) 


ics.aproach %>%
    ggplot(aes(x = aproach, y = statistic,
               ymin = conf.low,
               ymax = conf.high)) +
    geom_pointrange() +
    geom_point(size = 3) +
    labs(y = "F1-score",
         x = "") +
    theme(axis.title = element_text(size=10)) 

metricas_result %>%
ggplot() +
  geom_boxplot(aes(x=combination, y=max_num_access_node), fill = "white")  +
  geom_point(alpha = 0.4, aes(x=combination, y=max_num_access_node, color=aproach), position = "jitter") +
  coord_flip()

metricas_result %>%
ggplot() +
  geom_boxplot(aes(x=combination, y=max_durationMin), fill = "white")  +
  geom_point(alpha = 0.4, aes(x=combination, y=max_durationMin, color=aproach), position = "jitter") +
  coord_flip()

metricas_result %>%
  filter(combination == 'Publicsoft') %>% 
  ggplot() +
  geom_boxplot(aes(x=combination, y=max_durationMin), fill = "white")  +
  geom_point(alpha = 0.4, aes(x=combination, y=max_durationMin, color=aproach), position = "jitter")